home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / utility / rexxalgo.zip / TESTALG1.CMD < prev    next >
OS/2 REXX Batch file  |  1996-05-27  |  18KB  |  507 lines
  1. /* REXX **********************************************/
  2. /*                                                   */
  3. /* Name.......: TESTALG1.CMD                         */
  4. /* Function...: Test Rexx-algorithms from the file   */
  5. /*              RXALGO01.CMD:                        */
  6. /*               1. Bubble sort                      */
  7. /*               2. Binary search                    */
  8. /*               3. Insertion sort                   */
  9. /*               4. Quick sort                       */
  10. /*               5. Shell sort                       */
  11. /*               6. Square root                      */
  12. /*               7. Translation to lower case        */
  13. /*               8. Digital Audio Player (mciRexx)   */
  14. /*                                                   */
  15. /* Author.....: Janosch R. Kowalczyk                 */
  16. /*              Compuserve: 101572,2160              */
  17. /*                                                   */
  18. /* Create date: 26 May 1996                          */
  19. /* Version....: 1.0                                  */
  20. /*                                                   */
  21. /* Changes....: No                                   */
  22. /*                                                   */
  23. /* Notes......: Start this file with PMREXX to see   */
  24. /*              the output lines or comment out the  */
  25. /*              Say statements for Random and Sort   */
  26. /*              functions                            */
  27. /*                                                   */
  28. /* Made use of GREED.  26 May 1996 / 12:29:24   JRK  */
  29. /*****************************************************/
  30.  
  31. Say 'This file is the test-routine for the sample internal' 
  32. Say 'Rexx-subroutines from the file RXALGO01.CMD'
  33. Say 'Start this file with PMREXX to see the output lines'
  34. Say 'or comment out the Say statements of the stem-variable'
  35. Say 'from RandomStem and test-sort calls .'
  36. Say
  37. Say 'Refer to the source code of this file for more'
  38. Say 'informations, please.'
  39. Say 
  40. Say 'The sample calls of this routines follows.'
  41. Say 'Press any key to continue. '
  42.  
  43. If RxFuncQuery('SysLoadFuncs') Then Do
  44.   Call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  45.   Call SysLoadFuncs
  46. End /* If RxFuncQuery... */
  47.  
  48. Call CharIn
  49. Call SysCls
  50.  
  51. /*--------------(Set random numbers)-------------*/
  52. number = 100
  53. Call RandomStem number
  54. search_value = stem.1
  55.  
  56. /*-----------------(Bubble Sort)-----------------*/
  57. Say
  58. Say 'Test Bubble Sort.'
  59. start = Time(r)
  60. Call BubSort
  61. endTime = Time(r)
  62. Say 'Sort duration:' endTime
  63. /* Following 3 statements can be comment out */
  64. Do i = 1 To stem.0
  65.   Say stem.i
  66. End 
  67. /*--------------(Duration: 1.630000)-------------*/
  68.  
  69. /*----------------(Binary Search)----------------*/
  70. Say
  71. Say 'Test Binary Search. Search for:' search_value
  72. start = Time(r)
  73. found = BiSearch(search_value)
  74. endTime = Time(r)
  75. Say 'Search duration:' endTime
  76. If found > 0 Then Say stem.found
  77. Else Say 'Nothing found'
  78. /*--------------(Duration: 0.030000)-------------*/
  79.  
  80. /*--------------(Set random numbers)-------------*/
  81. number = 100
  82. Call RandomStem number
  83.  
  84. /*-----------------(Insert Sort)-----------------*/
  85. Say
  86. Say 'Test Insert Sort.'
  87. start = Time(r)
  88. Call InsSort
  89. endTime = Time(r)
  90. Say 'Sort duration:' endTime
  91. /* Following 3 statements can be comment out */
  92. Do i = 1 To stem.0
  93.   Say stem.i
  94. End 
  95. /*-------------(Duration: 1.590000)--------------*/
  96.  
  97. /*-------------(Set random numbers)--------------*/
  98. number = 100
  99. Call RandomStem number
  100.  
  101. /*-----------------(Quick Sort)------------------*/
  102. Say
  103. Say 'Test Quick Sort.'
  104. start = Time(r)
  105. Call QSort
  106. endTime = Time(r)
  107. Say 'Sort duration:' endTime
  108. /* Following 3 statements can be comment out */
  109. Do i = 1 To stem.0
  110.   Say stem.i
  111. End 
  112. /*-------------(Duration: 0.310000)--------------*/
  113.  
  114. /*-------------(Set random numbers)--------------*/
  115. number = 100
  116. Call RandomStem number
  117.  
  118. /*-----------------(Shell Sort)------------------*/
  119. Say
  120. Say 'Test Shell Sort.'
  121. start = Time(r)
  122. Call ShlSort
  123. endTime = Time(r)
  124. Say 'Sort duration:' endTime
  125. /* Following 3 statements can be comment out */
  126. Do i = 1 To stem.0
  127.   Say stem.i
  128. End 
  129. /*-------------(Duration: 0.880000)--------------*/
  130.  
  131. /*--------------(Test Square Root)---------------*/
  132. Say
  133. Say 'Sqrt('search_value') =' SqrRoot(search_value)
  134.  
  135. /*------------(Test To Lower Case)---------------*/
  136. Say
  137. Say ToLower('TEST TO LOWER CASE OF Ä, Ö AND Ü')
  138.  
  139. /*------------(Test Digital Player)--------------*/
  140. rc = RxFuncAdd('mciRxInit','MCIAPI','mciRxInit')
  141. Init_RC = mciRxInit()
  142.  
  143. /* Adjust following file name */
  144. Sound_File = 'D:\MMOS2\SOUNDS\bach.mid'
  145. Say 
  146. Say 'Sound file:' Sound_File 'is played. Please wait for the end.'
  147. rc = PlayFile(Sound_File)
  148. Call mciRxExit
  149.  
  150. Exit
  151.  
  152. /*===============(Internal subroutines)==============*/
  153.  
  154. /*==================(Binary search)==================*/
  155. /* :-))                                              */
  156. /* Name.......: BiSearch                             */
  157. /*                                                   */
  158. /* Function...: Search a stem variable for a value   */
  159. /* Call parm..: Search value                         */
  160. /* Returns....: 0 if nothing found                   */
  161. /*              index of the found value             */
  162. /* Sample call: found_index = BiSearch(value)        */
  163. /*              If found_index = 0 Then              */
  164. /*                Say 'Value' value 'not found!'     */
  165. /*              Else                                 */
  166. /*                Say stem.found_index               */
  167. /*                                                   */
  168. /* Notes......: The elements to search for must be   */
  169. /*              saved in the stem named so as the    */
  170. /*              stem in this Procedure (in this case */
  171. /*              "STEM.")                             */
  172. /*              stem.0 must contain the number of    */
  173. /*              elements in stem.                    */
  174. /*              The stem-variable must be in the     */
  175. /*              sorted order                         */
  176. /*                                                   */
  177. /* Changes....: No                                   */
  178. /*                                                   */
  179. /*===================================================*/
  180.  
  181. BiSearch: Procedure Expose stem.
  182.  
  183. Parse Arg value           /* Search value            */
  184.  
  185. found  = 0                /* Index of the found Item */
  186. bottom = 1                /* Index of the first Item */
  187. top    = stem.0           /* Index of the last Item  */
  188.  
  189. /*------------------(Binary Search)------------------*/
  190. Do While found = 0 & top >= bottom
  191.   mean = (bottom + top) % 2
  192.   If value = stem.mean Then
  193.     found = mean
  194.   Else If value < stem.mean Then
  195.     top = mean - 1
  196.   Else
  197.     bottom = mean + 1
  198. End /* Do While */
  199.  
  200. Return found
  201.  
  202.  
  203. /*===================(Bubble sort)===================*/
  204. /* :-I                                               */
  205. /* Name.......: BubSort                              */
  206. /*                                                   */
  207. /* Function...: Bubble Sort for a stem variable      */
  208. /* Call parm..: No                                   */
  209. /* Returns....: nothing (NULL string)                */
  210. /*                                                   */
  211. /* Sample call: Call BubSort                         */
  212. /*                                                   */
  213. /* Notes......: The elements to sort for must be     */
  214. /*              saved in the stem named so as the    */
  215. /*              stem in this Procedure (in this case */
  216. /*              "STEM.")                             */
  217. /*              stem.0 must contain the number of    */
  218. /*              elements in stem.                    */
  219. /*                                                   */
  220. /* Changes....: No                                   */
  221. /*                                                   */
  222. /*===================================================*/
  223.  
  224. BubSort: Procedure Expose stem.
  225.  
  226. /*------------(Bubble Sort for the Stem)-------------*/
  227. Do i = stem.0 To 1 By -1 Until flip_flop = 1
  228.   flip_flop = 1